;;; -*- Mode:LISP; Package:USER; Base:8 -*-

;;; Versatec functions

(DEFVAR VERSATEC-CONTROL-SETTING 0)             ;Has any bits which need to be on in ctl reg
(DEFVAR VERSATEC-PLOTTER-CONTROL 777510)
(DEFVAR VERSATEC-PLOTTER-DATA 777512)
(DEFVAR VERSATEC-PLOTTER-BYTE-COUNT 777500)
(DEFVAR VERSATEC-PRINTER-CONTROL 777514)
(DEFVAR VERSATEC-PRINTER-DATA 777516)
(DEFVAR VERSATEC-PRINTER-BYTE-COUNT 777504)
(DEFVAR VERSATEC-CONTROL)                       ;Bound to appropriate control location
(DEFVAR VERSATEC-BUFFER-ADDRESS 777506)
(DEFVAR VERSATEC-BUFFER-EXT-ADDRESS 777502)

(DEFUN VERSATEC-WAIT ()
  (DO ((STATE))
      (())
;    (PROCESS-WAIT "Versatec" #'(LAMBDA (UL &AUX S)
;                                ;; Wait for ready or error, and dma-busy off
;                                (AND (BIT-TEST (SETQ S (%UNIBUS-READ UL)) 100200)
;                                     (NOT (BIT-TEST S 20000))))
;                 VERSATEC-CONTROL)
    (SETQ STATE (%UNIBUS-READ VERSATEC-CONTROL))
    (COND ((BIT-TEST STATE 100000)
           (FERROR NIL "Versatec error, status is ~O" STATE))
          ((BIT-TEST STATE 200)
           (RETURN T)))))

(DEFUN VERSATEC-PRINT-CHAR (CHAR &AUX (VERSATEC-CONTROL VERSATEC-PRINTER-CONTROL))
  (VERSATEC-WAIT)
  (%UNIBUS-WRITE VERSATEC-PRINTER-DATA CHAR))

(DEFUN VERSATEC-PLOT-BYTE (BYTE &AUX (VERSATEC-CONTROL VERSATEC-PLOTTER-CONTROL))
  (VERSATEC-WAIT)
  (%UNIBUS-WRITE VERSATEC-PLOTTER-DATA BYTE))

(DEFUN VERSATEC-RESET ()
  (%UNIBUS-WRITE VERSATEC-CONTROL 6))           ;Reset interface and buffer

(DEFUN VERSATEC-REMOTE-LINE-TERMINATE ()
  (VERSATEC-WAIT)
  (%UNIBUS-WRITE VERSATEC-CONTROL (LOGIOR VERSATEC-CONTROL-SETTING 40)))

(DEFUN VERSATEC-REMOTE-FORM-FEED ()
  (VERSATEC-WAIT)
  (%UNIBUS-WRITE VERSATEC-CONTROL (LOGIOR VERSATEC-CONTROL-SETTING 20)))

(DEFUN VERSATEC-REMOTE-END-OF-TRANSMISSION ()
  (VERSATEC-WAIT)
  (%UNIBUS-WRITE VERSATEC-CONTROL (LOGIOR VERSATEC-CONTROL-SETTING 10)))

(DEFUN VERSATEC-TEST (&AUX (VERSATEC-CONTROL VERSATEC-PRINTER-CONTROL))
  (VERSATEC-RESET)
  (DOTIMES (I 25.)
    (DOTIMES (I 100)
      (VERSATEC-PRINT-CHAR (+ I 100)))
    (VERSATEC-PRINT-CHAR 15))
  (VERSATEC-PRINT-CHAR 4))

(DEFUN VERSATEC-QWOPY (&OPTIONAL (SCREEN SI:TV-CPT-SCREEN)
                       &AUX ARRAY W H (VERSATEC-CONTROL VERSATEC-PLOTTER-CONTROL))
  (SETQ ARRAY (MAKE-ARRAY
                (LIST (SETQ W (FLOOR (SCREEN-WIDTH SCREEN) 8.))
                      (SETQ H (SCREEN-HEIGHT SCREEN)))
                ':TYPE  'ART-8B
                ':DISPLACED-TO (SCREEN-BUFFER-PIXEL-ARRAY SCREEN)))
  (VERSATEC-RESET)
  (DOTIMES (Y H)
    (DOTIMES (X W)
      (VERSATEC-PLOT-BYTE (AREF ARRAY (- W X 1) (- H Y 1))))
    (VERSATEC-REMOTE-LINE-TERMINATE))
  (VERSATEC-REMOTE-END-OF-TRANSMISSION))

(DEFUN VERSATEC-COPY (&OPTIONAL (INPUT-ARRAY (SCREEN-BUFFER-PIXEL-ARRAY SI:TV-CPT-SCREEN))
                      &AUX ARRAY-8B LINE-ARRAY
                           (W (ARRAY-DIMENSION-N 1 INPUT-ARRAY))
                           (H (ARRAY-DIMENSION-N 2 INPUT-ARRAY))
                           A8W UB-ADR
                           (VERSATEC-CONTROL VERSATEC-PLOTTER-CONTROL))
  (VERSATEC-RESET)
  (SETQ LINE-ARRAY (MAKE-ARRAY (* 2 H) ':TYPE 'ART-1B))
  (SETQ ARRAY-8B (MAKE-ARRAY (SETQ A8W (FLOOR H 4))
                             ':TYPE 'ART-8B
                             ':DISPLACED-TO LINE-ARRAY))
  (UNWIND-PROTECT
    (PROGN
      (SETQ UB-ADR (WIRE-ARRAY-AND-MAP LINE-ARRAY T 766142))
      (DOTIMES (X W)
        ;; Copy sideways line into buffer
        (DOTIMES (Y H)
          (LET ((BIT (AREF INPUT-ARRAY (- W X 1) Y)))
            (ASET BIT LINE-ARRAY (* 2 Y))
            (ASET BIT LINE-ARRAY (1+ (* 2 Y)))))
        ;; Now have line in line buffer, print it twice
        (VERSATEC-WAIT)
        (%UNIBUS-WRITE VERSATEC-BUFFER-ADDRESS UB-ADR)
        (%UNIBUS-WRITE VERSATEC-BUFFER-EXT-ADDRESS 0)
        (%UNIBUS-WRITE VERSATEC-PLOTTER-BYTE-COUNT A8W)
;       (DOTIMES (I A8W)
;         (%UNIBUS-WRITE VERSATEC-PLOTTER-DATA (AREF ARRAY-8B I)))
        (VERSATEC-REMOTE-LINE-TERMINATE)
        (VERSATEC-WAIT)
        (%UNIBUS-WRITE VERSATEC-BUFFER-ADDRESS UB-ADR)
        (%UNIBUS-WRITE VERSATEC-BUFFER-EXT-ADDRESS 0)
        (%UNIBUS-WRITE VERSATEC-PLOTTER-BYTE-COUNT A8W)
;       (DOTIMES (I A8W)
;         (%UNIBUS-WRITE VERSATEC-PLOTTER-DATA (AREF ARRAY-8B I)))
        (VERSATEC-REMOTE-LINE-TERMINATE)))
    (VERSATEC-REMOTE-END-OF-TRANSMISSION)
    (VERSATEC-WAIT)
    (WIRE-ARRAY-AND-MAP LINE-ARRAY NIL)))

(DEFUN VERSATEC-BIG-COPY (&OPTIONAL (INPUT-ARRAY (SCREEN-BUFFER-PIXEL-ARRAY SI:TV-CPT-SCREEN))
                                    (SCALE 9.) (MARGIN 100.)
                          &AUX ARRAY-8B LINE-ARRAY
                               (W (ARRAY-DIMENSION-N 1 INPUT-ARRAY))
                               (H (ARRAY-DIMENSION-N 2 INPUT-ARRAY))
                               (LSIZE (+ MARGIN 7 (* W SCALE)))
                               A8W UB-ADR
                               (VERSATEC-CONTROL VERSATEC-PLOTTER-CONTROL))
  (VERSATEC-RESET)
  (SETQ LINE-ARRAY (MAKE-ARRAY LSIZE ':TYPE 'ART-1B))
  (SETQ ARRAY-8B (MAKE-ARRAY (SETQ A8W (FLOOR LSIZE 8))
                             ':TYPE 'ART-8B
                             ':DISPLACED-TO LINE-ARRAY))
  (UNWIND-PROTECT
    (PROGN
      (SETQ UB-ADR (WIRE-ARRAY-AND-MAP LINE-ARRAY T 766142))
      (DOTIMES (Y H)
        ;; Copy sideways line into buffer
        (DOTIMES (X W)
          (LET ((BIT (AREF INPUT-ARRAY X Y))
                (XPOS (+ MARGIN (* SCALE X))))
            (DOTIMES (I SCALE)
              (ASET BIT LINE-ARRAY (+ I XPOS)))))
        ;; Now have line in line buffer, print it twice
        (DOTIMES (I SCALE)
          (VERSATEC-WAIT)
          (%UNIBUS-WRITE VERSATEC-BUFFER-ADDRESS UB-ADR)
          (%UNIBUS-WRITE VERSATEC-BUFFER-EXT-ADDRESS 0)
          (%UNIBUS-WRITE VERSATEC-PLOTTER-BYTE-COUNT A8W)
;         (DOTIMES (I A8W)
;           (%UNIBUS-WRITE VERSATEC-PLOTTER-DATA (AREF ARRAY-8B I)))
          (VERSATEC-REMOTE-LINE-TERMINATE))))
    (VERSATEC-REMOTE-FORM-FEED)
    (VERSATEC-WAIT)
    (WIRE-ARRAY-AND-MAP LINE-ARRAY NIL)))

(DEFUN WIRE-ARRAY-AND-MAP (ARRAY &OPTIONAL (WIRE-P T) (UB-MAP-LOC 766140))
  (LET ((NPAGES (1+ (- (FLOOR (+ (%POINTER ARRAY) (%STRUCTURE-TOTAL-SIZE ARRAY))
                              SYS:PAGE-SIZE)
                       (FLOOR (%POINTER ARRAY) SYS:PAGE-SIZE))))
        (SWAP-STATUS (COND (WIRE-P SYS:%PHT-SWAP-STATUS-WIRED)
                           (T SYS:%PHT-SWAP-STATUS-NORMAL)))
        (LOC (LOGAND (%POINTER ARRAY) (- SYS:PAGE-SIZE))))
    (DOTIMES (I NPAGES)
      (DO ()
          ((SYS:%CHANGE-PAGE-STATUS LOC SWAP-STATUS NIL)
           (AND WIRE-P
                (%UNIBUS-WRITE (+ (* 2 I) UB-MAP-LOC)
                               (+ 100000 (LSH (SYS:%PHYSICAL-ADDRESS LOC) -8.)))))
        (%P-LDB 1 LOC))  ;If page not swapped in, reference and try again
      (SETQ LOC (+ LOC SYS:PAGE-SIZE))))
  (DPB (LSH UB-MAP-LOC -1)
       1204
       (+ 140000 (LSH (+ (LOGAND (1- SYS:PAGE-SIZE) (%POINTER ARRAY))
                         (%P-LDB-OFFSET SYS:%%ARRAY-NUMBER-DIMENSIONS ARRAY 0)
                         (%P-LDB-OFFSET SYS:%%ARRAY-LONG-LENGTH-FLAG ARRAY 0))
                      2))))

(DEFUN VERSATEC-TEST (&OPTIONAL (I 0)
                      &AUX ARRAY-8B LINE-ARRAY
                           (W 1400)
                           (H 1600)
                           A8W UB-ADR
                           (VERSATEC-CONTROL VERSATEC-PLOTTER-CONTROL))
  (VERSATEC-RESET)
  (SETQ LINE-ARRAY (MAKE-ARRAY (* 2 H) ':TYPE 'ART-1B))
  (SETQ ARRAY-8B (MAKE-ARRAY (SETQ A8W (FLOOR H 4))
                             ':TYPE 'ART-8B
                             ':DISPLACED-TO LINE-ARRAY))
  (UNWIND-PROTECT
    (PROGN
      (SETQ UB-ADR (WIRE-ARRAY-AND-MAP LINE-ARRAY T 766142))
      (DOTIMES (X (* 2 H))
        (ASET (IF (= I (LOGAND X 7)) 0 -1)
              LINE-ARRAY X))
      (DO () ((KBD-TYI-NO-HANG))
        ;; Now have line in line buffer, print it N times
        (VERSATEC-WAIT)
        (%UNIBUS-WRITE VERSATEC-BUFFER-ADDRESS UB-ADR)
        (%UNIBUS-WRITE VERSATEC-BUFFER-EXT-ADDRESS 0)
        (%UNIBUS-WRITE VERSATEC-PLOTTER-BYTE-COUNT A8W)
;       (DOTIMES (I A8W)
;         (%UNIBUS-WRITE VERSATEC-PLOTTER-DATA (AREF ARRAY-8B I)))
        (VERSATEC-REMOTE-LINE-TERMINATE)
        (VERSATEC-WAIT)
        (%UNIBUS-WRITE VERSATEC-BUFFER-ADDRESS UB-ADR)
        (%UNIBUS-WRITE VERSATEC-BUFFER-EXT-ADDRESS 0)
        (%UNIBUS-WRITE VERSATEC-PLOTTER-BYTE-COUNT A8W)
;       (DOTIMES (I A8W)
;         (%UNIBUS-WRITE VERSATEC-PLOTTER-DATA (AREF ARRAY-8B I)))
        (VERSATEC-REMOTE-LINE-TERMINATE)))
    (VERSATEC-REMOTE-FORM-FEED)
    (VERSATEC-WAIT)
    (WIRE-ARRAY-AND-MAP LINE-ARRAY NIL)))
